Attribute VB_Name = "modAC"
Option Explicit

' This file is part of Nightowl.
'
' Nightowl is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.

' Nightowl is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with Nightowl.  If not, see <http://www.gnu.org/licenses/>.


Const SW_SHOWMAXIMIZED = 3
Const SW_SHOWMINIMIZED = 2
Const SW_SHOWDEFAULT = 10
Const SW_SHOWMINNOACTIVE = 7
Const SW_SHOWNORMAL = 1

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long

Public Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long
Public Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long
   Public Declare Function VarPtr Lib "msvbvm60.Dll" (Var As Any) As Long

Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_OPEN_TYPE_PROXY = 3

Public Const scUserAgent = "VB OpenUrl"
Public Const INTERNET_FLAG_RELOAD = &H80000000

Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
(ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, _
ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Declare Function InternetReadFile Lib "wininet.dll" _
(ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer

Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer

'Process Handling

Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function EnumProcesses Lib "PSAPI.DLL" ( _
lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" ( _
ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
Private Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" ( _
ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_QUERY_INFORMATION = &H400




Public Const SoftwareName  As String = "NightOwl"
Public IniFile As String
Public IM As IniManager
Public ServerListFile As String
Public LangPath As String
Public ThemePath As String 'Added by Erion
Public Const homepage As String = "http://nightowl.try.hu"
Public Const FeedbackUrl As String = "http://nvda.hu/nightowl/feedback.php?nick=%s&message=%s"
Public Const fb_success As Byte = 1
Public Const fb_failed As Byte = 0
Public Const DefaultSapiRate As Integer = 5
Public Const DefaultConfirmExit As Boolean = True
Public Const defaultWAlert As Boolean = True
Public Const DefaultWSoundOn As Boolean = True
Public Const DefaultWSoundOff As Boolean = True
Public Const DefaultUseSounds As Integer = 1
Public Const DefaultNick As String = "NightOwl_User"
Public Const DefaultLargePrint As Integer = 0
Public Const DefaultAutoLog As Integer = 0
Public Const DefaultShowServersAtStartUp As Byte = 1

' Debug only
Public WriteDebugs As Boolean



' enforcer
Public NoReconnect As Boolean

' Make a private channel
Public OnJoinSetPriv As Boolean

Public Settings As ACSettings
Public lang As Lng
Public servers() As ServerList
Public GlobalIgnore As Boolean


Public Type ServerList
sName As String
address As String
Port As Integer
End Type




Public Type ACSettings

  SpeechType As Integer
  Nickname As String
  MyIdent As String ' Added by MG Bledig
  MyName As String
  MyMail As String
  UseSounds As Integer
  KnownIgnores As String
  LargePrint As Integer
  AutoLog As Integer
  Caps As Boolean
    ConfirmExit As Boolean
      Blacklist As String
    SAPIVoice As String
  SAPIRate As Integer
    WSoundOn As Boolean
  WSoundOff As Boolean
  WAlert As Boolean
  WList As String
  Language As String
  QuitMsg As String
  ShowServersAtStartup As Byte
    Theme As String
    ThemeExt As String
    End Type



'Language
Public Type Lng
Messages() As String
Buttons() As String
Help() As String
SpeechMsg() As String
MenuMsg() As String
LangName As String
LangVer As String
Translator As String
TContact As String
End Type

Private cChannel As String
Private cPM As String


Property Let InPM(ByVal PMNick As String)

If PMNick = "" Then
  frmMain.lblCurrentChan = currentChannel
  frmMain.lstUsers.Visible = True
  frmMain.IRCInterface.SendMessage cChannel, "My private conversation has ended."
Else
  frmMain.lblCurrentChan = "Private with " + PMNick
  frmMain.lstUsers.Visible = False
  frmMain.IRCInterface.SendMessage cChannel, "I am now entering a private conversation with " & PMNick & "."
End If

frmMain.txtInput.Text = ""
frmMain.txtInput.SetFocus

cPM = PMNick

End Property

Property Get InPM() As String

InPM = cPM

End Property

Property Let currentChannel(ByVal ChName As String)

GlobalIgnore = False
If frmMain.mnuSound.Checked = True Then Settings.UseSounds = 1
frmMain.sBar.Panels(3).Text = ""
frmMain.mnuGIgnore.Checked = False

If ChName = "" Then
  With frmMain
    .txtInput.Visible = False
    .txtHistory.Visible = False
    .mnuPart.Enabled = False
    .mnuGetBan.Enabled = False
    .lstUsers.Visible = False
    .lblCurrentChan = "Not on a channel"
    .Label1.Visible = False
    .Label2.Visible = False
    .mnuGIgnore.Enabled = False
    End With
  If cChannel <> "" Then frmMain.IRCInterface.PartChannel cChannel
Else
  With frmMain
    .txtInput.Visible = True
    .txtHistory.Visible = True
    .lstUsers.Visible = True
    .mnuPart.Enabled = True
    .mnuGetBan.Enabled = True
    .lblCurrentChan = ChName
    .Label1.Visible = True
    .Label2.Visible = True
        .mnuGIgnore.Enabled = True
    .txtInput.SetFocus
    .SpeechInterface.StopSpeech
    .AddToHistory "Joining channel " & ChName, True
    .IRCInterface.JoinChannel ChName
      If cChannel <> "" Then
    If LCase(cChannel) <> LCase(ChName) Then .IRCInterface.PartChannel cChannel
  Else
    .txtHistory.Text = ""
  End If
  End With
End If
cChannel = ChName

End Property

Property Get currentChannel() As String

currentChannel = cChannel

End Property

Public Sub SaveSettings()
IM.FileName = IniFile


  IM.WriteKeyValue "System", "SpeechType", CStr(Settings.SpeechType)
    IM.WriteKeyValue "System", "UseSounds", CStr(Settings.UseSounds)
  IM.WriteKeyValue "System", "KnownIgnores", Settings.KnownIgnores
  IM.WriteKeyValue "System", "LargePrint", CStr(Settings.LargePrint)
    IM.WriteKeyValue "System", "AutoLog", CStr(Settings.AutoLog)
       IM.WriteKeyValue "User", "ConfirmExit", CStr(Settings.ConfirmExit)
  IM.WriteKeyValue "SAPI", "Voice", Settings.SAPIVoice
  IM.WriteKeyValue "SAPI", "Rate", CStr(Settings.SAPIRate)
  IM.WriteKeyValue "System", "ZTI", Settings.Blacklist
  IM.WriteKeyValue "Watch", "List", Settings.WList
  IM.WriteKeyValue "Watch", "SoundOn", CStr(Settings.WSoundOn)
  IM.WriteKeyValue "Watch", "SoundOff", CStr(Settings.WSoundOff)
  IM.WriteKeyValue "Watch", "Alert", CStr(Settings.WAlert)
IM.WriteKeyValue "System", "Language", CStr(Settings.Language)
If Settings.QuitMsg <> "I was using " & SoftwareName & " " & CStr(App.Major) & "." & CStr(App.Minor) & "." Then
IM.WriteKeyValue "user", "quitmsg", CStr(Settings.QuitMsg)
End If
IM.WriteKeyValue "user", "Nickname", Settings.Nickname
IM.WriteKeyValue "user", "Ident", Settings.MyIdent ' Added by MG Bledig
IM.WriteKeyValue "user", "Email", Settings.MyMail ' Added by MG Bledig
IM.WriteKeyValue "user", "Name", Settings.MyName ' Added by MG Bledig

IM.WriteKeyValue "system", "ShowServersAtStartup", CStr(Settings.ShowServersAtStartup)

End Sub

Public Sub LoadSettings()
Dim strString As String

IM.FileName = IniFile
  strString = _
CStr(IM.GetKeyValue("System", "SpeechType"))
   If strString = "" Then
  Settings.SpeechType = -1
  Else
  Settings.SpeechType = CInt(strString)
InitSpeech
  End If
  strString = _
    IM.GetKeyValue("User", "Nickname")
  If strString = "" Then
  Settings.Nickname = DefaultNick
  Else
  Settings.Nickname = strString
  End If
    strString = _
    CStr(IM.GetKeyValue("System", "UseSounds"))
  If strString = "" Then
  Settings.UseSounds = DefaultUseSounds
  Else
  Settings.UseSounds = CInt(strString)
  End If
  Settings.KnownIgnores = _
    IM.GetKeyValue("System", "KnownIgnores")
  strString = _
    IM.GetKeyValue("System", "LargePrint")
  If strString = "" Then
  Settings.LargePrint = DefaultLargePrint
  Else
  Settings.LargePrint = CInt(strString)
  End If
  strString = _
    IM.GetKeyValue("System", "AutoLog")
  If strString = "" Then
  Settings.AutoLog = DefaultAutoLog
  Else
  Settings.AutoLog = CInt(strString)
  End If
  Settings.Blacklist = _
    IM.GetKeyValue("System", "ZTI")
strString = IM.GetKeyValue("User", "ConfirmExit")
If strString = "" Then
Settings.ConfirmExit = DefaultConfirmExit
Else
Settings.ConfirmExit = CBool(strString)
End If
     Settings.SAPIVoice = _
    IM.GetKeyValue("SAPI", "Voice")
  strString = IM.GetKeyValue("Sapi", "rate")
If strString = "" Then
Settings.SAPIRate = DefaultSapiRate
Else
Settings.SAPIRate = CInt(strString)
End If
strString = IM.GetKeyValue("watch", "alert")
If strString = "" Then
Settings.WAlert = defaultWAlert
Else
Settings.WAlert = CBool(strString)
End If
strString = IM.GetKeyValue("watch", "soundon")
If strString = "" Then
Settings.WSoundOn = DefaultWSoundOn
Else
Settings.WSoundOn = CBool(strString)
End If

strString = IM.GetKeyValue("watch", "soundoff")
If strString = "" Then
Settings.WSoundOff = DefaultWSoundOff
Else
Settings.WSoundOff = CBool(strString)
End If
  Settings.WList = _
    CStr(IM.GetKeyValue("Watch", "List"))
Settings.Language = _
    CStr(IM.GetKeyValue("System", "Language"))
Settings.QuitMsg = _
CStr(IM.GetKeyValue("user", "quitmsg"))
If Settings.QuitMsg = "" Then
Settings.QuitMsg = "I was using " & SoftwareName & " " & CStr(App.Major) & "." & CStr(App.Minor) & "."
End If
strString = _
IM.GetKeyValue("system", "ShowServersAtStartup")
If strString = "" Then
Settings.ShowServersAtStartup = DefaultShowServersAtStartUp
Else
Settings.ShowServersAtStartup = CByte(strString)
End If

strString = _
IM.GetKeyValue("system", "LargePrint")
If strString = "" Then
Settings.LargePrint = DefaultLargePrint
Else
Settings.LargePrint = CInt(strString)
End If

Settings.MyIdent = _
    IM.GetKeyValue("User", "Ident")
    
  Settings.MyMail = _
    IM.GetKeyValue("User", "Email")
  
  Settings.MyName = _
    IM.GetKeyValue("User", "Name")

End Sub

Function GetSoundName(ByVal SoundNumber As Integer) As String
Select Case SoundNumber
  Case 1
    GetSoundName = "Alien Laugh"
  Case 2
    GetSoundName = "Are You All Right"
  Case 3
GetSoundName = "All Righty Then"
Case 4
GetSoundName = "Bubbles"
Case 5
GetSoundName = "Buzz!"
Case 6
GetSoundName = "I Must Congratulate You"
Case 7
GetSoundName = "You're Despicable"
Case 8
GetSoundName = "Gimme Gimme Gimme!"
Case 9
GetSoundName = "You Gone Nuts Or Something?"
Case 10
GetSoundName = "Oh Goody"
Case 11
GetSoundName = "Crazy Laugh"
Case 12
GetSoundName = "Meep Meep"
Case 13
GetSoundName = "Are You Sure About This?"
End Select

End Function

Sub UpdateIgnore(IgnoreString As String)

If GetWord(IgnoreString, 1) = "<cont>" Then
  Settings.KnownIgnores = Settings.KnownIgnores + " " + _
    GetFromWord(IgnoreString, 2)
Else
  Settings.KnownIgnores = IgnoreString
End If

SaveSettings

End Sub

Function OpenLocation(URL As String, _
WindowState As Long) As Long

    Dim lHWnd As Long
    Dim lAns As Long

    lAns = ShellExecute(lHWnd, "open", URL, vbNullString, _
    vbNullString, WindowState)
   
    OpenLocation = lAns

    'ALTERNATIVE: if not interested in module handle or error
    'code change return value to boolean; then the above line
    'becomes:

    'OpenLocation = (lAns > 32)

End Function

Sub sendWatch()
Dim n As Long


' Sends the watch list to the server
If WordCount(Settings.WList) = 0 Then Exit Sub 'no list to send
frmMain.IRCInterface.RawSend "WATCH c" 'clear list
Dim SString As String
SString = "WATCH "
For n = 1 To WordCount(Settings.WList)
  SString = SString & "+" & GetWord(Settings.WList, n) & " "
  If Len(SString) > 384 Then
    frmMain.IRCInterface.RawSend SString
    SString = "WATCH "
  End If
Next
If SString <> "WATCH " Then frmMain.IRCInterface.RawSend SString
End Sub

Function IsChanop(Optional ByVal Nick As String) As Boolean
' this checks to see if the current user is a chanop
Dim c As Integer

If Nick = "" Then Nick = frmMain.IRCInterface.Nick

' If we're not on a room, we  exit cleanly.
If frmMain.lstUsers.ListCount = 0 Then IsChanop = False: Exit Function

' Begin a for loop to check.
For c = 0 To frmMain.lstUsers.ListCount - 1
  ' Compare the rightmost
  If LCase(Nick) = _
  LCase$( _
    Right$(frmMain.lstUsers.List(c), Len(frmMain.lstUsers.List(c)) - 1 _
    ) _
  ) Then
    ' check if the first char is an oper char
    Select Case Left$(frmMain.lstUsers.List(c), 1)
    Case "@", "&", "~", "%"
      IsChanop = True
    Case Else
      IsChanop = False
    End Select
    ' we don't need to waste time processing further
    Exit For
  End If
Next

End Function

Public Function sMsgBox(Prompt As String, Optional Buttons As VbMsgBoxStyle, Optional Title As String)
' This function is a drop-in for all MsgBox'es.
' It presents the message box while still sending its
' contents to the Speech engine.
frmMain.SpeechInterface.Say Title & " dialog. " & Prompt, True
MsgBox Prompt, Buttons, Title
End Function

'this is your basic rot13 cypher. it tur ' ns abcd into
'nopq and nopq into abc ' d. if you run it twice, you
'get the ' input.
Public Function rot13(ByVal s As String)

Dim X As Integer
For X = 1 To Len(s)
If Asc(UCase(Mid(s, X, 1))) > 64 And Asc(UCase(Mid(s, X, 1))) < 91 Then
rot13 = rot13 + LCase(Chr((((Asc(UCase(Mid(s, X, 1))) - 65) + 13) Mod 26) + 65))
Else
rot13 = rot13 + Mid(s, X, 1)
End If

Next

End Function

Public Sub LoadLang(LangFile As String)
IM.FileName = LangFile

CheckLang (GetSection("messages", lang.Messages, LangFile))
CheckLang (GetSection("Buttons", lang.Buttons, LangFile))
CheckLang (GetSection("SpeechMsg", lang.SpeechMsg, LangFile))
CheckLang (GetSection("Help", lang.Help, LangFile))
CheckLang (GetSection("MenuMsg", lang.MenuMsg, LangFile))
lang.LangName = IM.GetKeyValue("langinfo", "langname")
lang.LangVer = IM.GetKeyValue("langinfo", "langver")
lang.Translator = IM.GetKeyValue("langinfo", "translator")
lang.TContact = IM.GetKeyValue("langinfo", "translatorcontact")

End Sub


Public Function LanTrim(What As String)
Dim pos As Integer


pos = InStr(What, "=")

LanTrim = Mid(What, pos + 1, Len(What))

End Function

Private Function GetSection(ByVal SecName As String, ByRef Destination() As String, ByVal File As String) As Byte
Dim i As Integer



Destination = IM.GetSection(SecName)

If Destination(0) = "" Then
GetSection = 1
Exit Function
End If

For i = 0 To UBound(Destination)
Destination(i) = LanTrim(Destination(i))
Next i

End Function

Public Function GetHtml(sUrl As String) As String

Dim s As String
Dim hOpen As Long
Dim hOpenUrl As Long
Dim bDoLoop As Boolean
Dim bRet As Boolean
Dim sReadBuffer As String * 2048
Dim lNumberOfBytesRead As Long

hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
hOpenUrl = InternetOpenUrl(hOpen, sUrl, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)

bDoLoop = True
While bDoLoop
sReadBuffer = vbNullString
bRet = InternetReadFile(hOpenUrl, sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
s = s & Left(sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False

Wend

If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
If hOpen <> 0 Then InternetCloseHandle (hOpen)

GetHtml = s

End Function

Public Function LoadServerList(SFile As String) As Byte
Dim rs As Byte
Dim SLArray() As String

IM.FileName = SFile


SLArray = IM.GetAllSections()
If SLArray(0) = "" Then
LoadServerList = 1
Exit Function
End If
For rs = 0 To UBound(SLArray) - 1
If rs = 0 Then
ReDim servers(0) As ServerList
Else
ReDim Preserve servers(0 To UBound(servers) + 1) As ServerList
End If
servers(UBound(servers)).sName = SLArray(rs)
servers(UBound(servers)).address = IM.GetKeyValue(SLArray(rs), "host")
servers(UBound(servers)).Port = CInt(IM.GetKeyValue(SLArray(rs), "port"))
Next rs

End Function

Private Sub CheckLang(result As Byte)
If result = 1 Then
MsgBox "Error while loading the language file.", vbCritical + vbOKOnly, "Error"
End
End If
End Sub



Public Function ArrayInitialised(ByVal ppArray As Long) As Long

Call GetMem4(ppArray, VarPtr(ArrayInitialised))

End Function

Public Sub LoadSounds() 'Added by Erion
Dim Dest() As String
Dim i As Byte
IM.FileName = App.Path & "\sounds\default\default.ntf"

'GetSection "sounds", Dest, ThemePath & "\" & Settings.Theme & "\" & Settings.Theme & Settings.ThemeExt
MsgBox GetSection("sounds", Dest, App.Path & "\sounds\default\default.ntf")

For i = 0 To UBound(Dest)
MsgBox Dest(i)
Next i

End Sub

Public Sub InitSpeech() 'Added by Erion

If Settings.SpeechType <> -1 Then
Set frmMain.SpeechInterface = New Speech
End If

End Sub


Public Function TF(bVal As Boolean) As Integer
    If bVal Then
        TF = 1
    Else
        TF = 0
    End If
End Function

'A function to see if a process is running

Public Function IsProcessRunning(ByVal sProcess As String) As Boolean
Const MAX_PATH As Long = 260
Dim lProcesses() As Long, lModules() As Long, n As Long, lRet As Long, hProcess As Long
Dim sName As String

sProcess = UCase$(sProcess)

ReDim lProcesses(1023) As Long
If EnumProcesses(lProcesses(0), 1024 * 4, lRet) Then
For n = 0 To (lRet \ 4) - 1
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcesses(n))
If hProcess Then
ReDim lModules(1023)
If EnumProcessModules(hProcess, lModules(0), 1024 * 4, lRet) Then
sName = String$(MAX_PATH, vbNullChar)
GetModuleBaseName hProcess, lModules(0), sName, MAX_PATH
sName = Left$(sName, InStr(sName, vbNullChar) - 1)
If Len(sName) = Len(sProcess) Then
If sProcess = UCase$(sName) Then IsProcessRunning = True: Exit Function
End If
End If
End If
CloseHandle hProcess
Next n
End If
End Function

Public Function GenerateIdent(arg1 As String) As String 'Added by Erion

GenerateIdent = rot13(SPrintF("ab_%s", arg1))

End Function
